Delphi Programmer's Power Pack/Delphi Volume 1.iso/e_to_l/flicplay/flicplay.pas

Pascal/Delphi Source File | 1996-09-15 | 17.2 KB | 685 lines

{+--------------------------------------------------------------------------+
 | Component: TFlicPlayer
 | Created: 3/30/96 2:58:22 PM
 | Author:  Jeff Kinzer
 | Copyright 1996, all rights reserved.
 | Description: Plays Autodesk Animations (.FLI & .FLC)
 | Version: 1.0
 | Revision: 1
 | VCS Filename: FlicPlay.Pav
 +--------------------------------------------------------------------------+}
unit FlicPlay;

interface

uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, ExtCtrls, StdCtrls, Menus, FlicDef;

type
   TTransition = (trNone, trFadeBlack, trFadeWhite);
   TPlaySpeed = 0..1000;
   TDesignedSpeed = TPlaySpeed;
   TFlicFrames = 0..High(LongInt);
   TPlayLoops = 0..High(Integer);
   TPlayPosition = TFlicFrames;
   TChangemode = (cmPlay, cmStop, cmPause);
   TPlayStatus = (psStopped, psQueued, psPlaying, psPaused, psDone);
   TTransitionTime = 0..High(Integer);
   TPlayType = (ptFlic, ptDIB);

   TFlicPlayer = class(TWinControl)
   private
      FFileType: TPlayType;
      FTimeOut: TTransitionTime;
      FTimeIn: TTransitionTime;
      FStatus: TPlayStatus;
      FAutoPlay: Boolean;
      FTransitionIn: TTransition;
      FTransitionOut: TTransition;
      FAutoSize: Boolean;
      FPosition: TPlayPosition;
      FFileName: TFileName;
      FSpeed: TPlaySpeed;
      FDesignedSpeed: TDesignedSpeed;
      FFrames: TFlicFrames;
      FLoops: TPlayLoops;
      FPlaying: Boolean;
      FStopped: Boolean;
      FPaused: Boolean;
      FOnPlay: TNotifyEvent;
      FOnPause: TNotifyEvent;
      FOnStop: TNotifyEvent;
      FAnimWnd,
      FFlicWnd: HWnd;
      function GetFileName: TFileName;
      procedure SetFileName(newValue: TFileName);
      function GetSpeed: TPlaySpeed;
      procedure SetSpeed(newValue: TPlaySpeed);
      function GetDesignedSpeed: TDesignedSpeed;
      procedure SetDesignedSpeed(newValue: TDesignedSpeed);
      function GetFrames: TFlicFrames;
      procedure SetFrames(newValue: TFlicFrames);
      function GetLoops: TPlayLoops;
      procedure SetLoops(newValue: TPlayLoops);
      function GetPlaying: Boolean;
      procedure SetPlaying(newValue: Boolean);
      function GetStopped: Boolean;
      procedure SetStopped(newValue: Boolean);
      function GetPaused: Boolean;
      procedure SetPaused(newValue: Boolean);
      function RunTime: Boolean;        { Returns true if it's run-time when called. }
      function GetPosition: TPlayPosition;
      procedure SetPosition(newValue: TPlayPosition);
      function GetAutoSize: Boolean;
      procedure SetAutoSize(newValue: Boolean);
      function GetTransitionIn: TTransition;
      procedure SetTransitionIn(newValue: TTransition);
      function GetTransitionOut: TTransition;
      procedure SetTransitionOut(newValue: TTransition);
      function GetAutoPlay: Boolean;
      procedure SetAutoPlay(newValue: Boolean);
      function GetStatus: TPlayStatus;
      procedure SetStatus(newValue: TPlayStatus);
      function GetTimeIn: TTransitionTime;
      procedure SetTimeIn(newValue: TTransitionTime);
      function GetTimeOut: TTransitionTime;
      procedure SetTimeOut(newValue: TTransitionTime);
      function GetFileType: TPlayType;
      procedure SetFileType(newValue: TPlayType);
   protected
      procedure TriggerPlayEvent; virtual;
      procedure TriggerPauseEvent; virtual;
      procedure TriggerStopEvent; virtual;
      procedure WMMove(var Msg: TWMMove); message WM_Move;
      procedure WMSize(var Msg: TWMSize); message WM_Size;
      procedure WMCreate(var Msg: TWMCreate); message WM_CREATE;
      procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
      procedure ResizeComponent; dynamic;
      procedure ChangeMode(Mode: TChangeMode); virtual;
      function GetValueOf(Value: LongInt): LongInt;
   public
      constructor Create(Owner: TComponent); override;
      procedure Play; virtual;
      procedure Pause; virtual;
      procedure Stop; virtual;
      property Stopped: Boolean read GetStopped write SetStopped default True;
      property Paused: Boolean read GetPaused write SetPaused default False;
      procedure LoadFromFile(FileStr: TFileName); virtual;
      property AnimationHandle: HWnd read FFlicWnd;
      function Next: Boolean; virtual;
      function Prev: Boolean; virtual;
      procedure First; virtual;
      procedure Last; virtual;
      function MoveBy(Amount: LongInt): Boolean; virtual;
      function MoveTo(Frame: LongInt): Boolean; virtual;
   published
      property FileName: TFileName read GetFileName write SetFileName;
      property Speed: TPlaySpeed read GetSpeed write SetSpeed default 0;
      property DesignedSpeed: TDesignedSpeed read GetDesignedSpeed write SetDesignedSpeed;
      property Frames: TFlicFrames read GetFrames write SetFrames;
      property Loops: TPlayLoops read GetLoops write SetLoops default 1;
      property Playing: Boolean read GetPlaying write SetPlaying default False;
      property Position: TPlayPosition read GetPosition write SetPosition;
      property Color;
      property Ctl3D;
      property DragCursor;
      property DragMode;
      property ParentColor;
      property ParentCtl3D;
      property ParentShowHint;
      property PopupMenu;
      Property OnPlay: TNotifyEvent read FOnPlay write FOnPlay;
      Property OnPause: TNotifyEvent read FOnPause write FOnPause;
      Property OnStop: TNotifyEvent read FOnStop write FOnStop;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property AutoSize: Boolean read GetAutoSize write SetAutoSize default True;
      property TransitionIn: TTransition read GetTransitionIn write SetTransitionIn default trFadeBlack;
      property TransitionOut: TTransition read GetTransitionOut write SetTransitionOut default trFadeBlack;
      property AutoPlay: Boolean read GetAutoPlay write SetAutoPlay default False;
      property Status: TPlayStatus read GetStatus write SetStatus default psStopped;
      property TimeIn: TTransitionTime read GetTimeIn write SetTimeIn;
      property TimeOut: TTransitionTime read GetTimeOut write SetTimeOut;
      property FileType: TPlayType read GetFileType write SetFileType;
   end;

function StartPlay(AnimWin, FocusWin: HWnd): Boolean;
procedure Register;

implementation

function TFlicPlayer.GetFileType: TPlayType;
begin
   FFileType := TPlayType(Word(GetValueOf(AA_FILETYPE)));
   Result := FFileType;
end;

procedure TFlicPlayer.SetFileType(NewValue: TPlayType);
begin
end;


function TFlicPlayer.GetTimeOut: TTransitionTime;
begin
   FTimeOut := GetValueOf(AA_TIMEOUT);
   Result := FTimeOut;
end;

procedure TFlicPlayer.SetTimeOut(NewValue: TTransitionTime);
begin
   if FTimeOut <> NewValue then
   begin
      FTimeOut := NewValue;
      aaSetParm(FFlicWnd, AA_TIMEOUT, 0, NewValue);
   end;
end;

function TFlicPlayer.GetTimeIn: TTransitionTime;
begin
   FTimeIn := GetValueOf(AA_TIMEIN);
   Result := FTimeIn;
end;

procedure TFlicPlayer.SetTimeIn(NewValue: TTransitionTime);
begin
   if FTimeIn <> NewValue then
   begin
      FTimeIn := NewValue;
      aaSetParm(FFlicWnd, AA_TIMEIN, 0, NewValue);
   end;
end;

function TFlicPlayer.GetStatus: TPlayStatus;
var
   Num: Word;
begin
   Num := Word(GetValueOf(AA_STATUS)) + 1;
   FStatus := TPlayStatus(Num);
   Result := FStatus;
end;

procedure TFlicPlayer.SetStatus(NewValue: TPlayStatus);
begin
end;

function TFlicPlayer.GetAutoPlay: Boolean;
begin
   Result := FAutoPlay;
end;

procedure TFlicPlayer.SetAutoPlay(NewValue: Boolean);
begin
   if FAutoPlay <> NewValue then
   begin
      FAutoPlay := NewValue;
      if FAutoPlay and (FFlicWnd <> 0) and (not FPlaying) then
         Play
      else
         if (FFlicWnd <> 0) and (not FStopped) then
            Stop;
   end;
end;

function TFlicPlayer.GetTransitionIn: TTransition;
var
   Num: Word;
begin
   Num := Word(GetValueOf(AA_TRANSIN));
   FTransitionIn := TTransition(Num);
   Result := FTransitionIn;
end;

procedure TFlicPlayer.SetTransitionIn(NewValue: TTransition);
begin
   if FTransitionIn <> NewValue then
   begin
      FTransitionIn := NewValue;
      aaSetParm(FFlicWnd, AA_TRANSIN, 0, Ord(NewValue));
   end;
end;

function TFlicPlayer.GetTransitionOut: TTransition;
var
   Num: Word;
begin
   Num := Word(GetValueOf(AA_TRANSOUT));
   FTransitionOut := TTransition(Num);
   Result := FTransitionOut;
end;

procedure TFlicPlayer.SetTransitionOut(NewValue: TTransition);
begin
   if FTransitionOut <> NewValue then
   begin
      FTransitionOut := NewValue;
      aaSetParm(FFlicWnd, AA_TRANSOUT, 0, Ord(NewValue));
   end;
end;

function TFlicPlayer.Next: Boolean;
begin
   FPosition := GetValueOf(AA_POSITION);
   if FPlaying or FPaused then
      Stop;
   Result := FPaused;
   if FPosition < (Frames - 1) then
      Position := FPosition + 1
   else
      First;
end;

function TFlicPlayer.Prev: Boolean;
begin
   FPosition := GetValueOf(AA_POSITION);
   if FPlaying or FPaused then
      Stop;
   Result := FPaused;
   if FPosition > 0 then
      Position := FPosition - 1
   else
      Last;
end;

procedure TFlicPlayer.First;
begin
   FPosition := GetValueOf(AA_POSITION);
   if FPlaying or FPaused then
      Stop;
   Position := 0;
end;

procedure TFlicPlayer.Last;
begin
   FPosition := GetValueOf(AA_POSITION);
   if FPlaying or FPaused then
      Stop;
   if FPosition <> (Frames - 1) then
      Position := Frames - 1;
end;

function TFlicPlayer.MoveBy(Amount: LongInt): Boolean;
var
   ToEnd, ToStart: LongInt;
begin
   ToEnd := (FFrames - 1) - FPosition;
   ToStart := FPosition;
   if FPlaying or FPaused then
      Stop;
   if Amount > 0 then
   begin
      if Amount > ToEnd then
         MoveTo(Amount - ToEnd)
      else
         MoveTo(FPosition + Amount);
   end
   else
   begin
      if Amount > ToStart then
         MoveTo((FFrames - 1) - (Amount - ToStart))
      else
         MoveTo(FPosition + Amount);
   end;
end;

function TFlicPlayer.MoveTo(Frame: LongInt): Boolean;
begin
   Result := (FPosition <> Frame) and (Frame >= 0) and (Frame < FFrames);
   if Result then
      aaSetParm(FFlicWnd, AA_POSITION, 0, Frame);
   FPosition := GetValueOf(AA_POSITION);
end;


function TFlicPlayer.GetAutoSize: Boolean;
begin
   Result := FAutoSize;
end;

procedure TFlicPlayer.SetAutoSize(NewValue: Boolean);
begin
   if FAutoSize <> NewValue then
   begin
      FAutoSize := NewValue;
      if FAutoSize then
      begin
         Width := GetValueOf(AA_WIDTH);
         Height := GetValueOf(AA_HEIGHT);
      end;
   end;
end;

function TFlicPlayer.GetPosition: TPlayPosition;
begin
   FPosition := GetValueOf(AA_POSITION);
   Result := FPosition;
end;

procedure TFlicPlayer.SetPosition(NewValue: TPlayPosition);
begin
   if FPosition <> NewValue then
   begin
      if FPlaying or FPaused then
         Stop;
      MoveTo(NewValue);
   end;
end;

function TFlicPlayer.GetFileName: TFileName;
begin
   Result := FFileName;
end;

procedure TFlicPlayer.SetFileName(NewValue: TFileName);
begin
   if not FileExists(NewValue) then
      Exit;
   if FFileName <> NewValue then
   begin
      if FPlaying or FPaused then
         Stop;
      FFileName := NewValue;
      LoadFromFile(FFileName);
   end;
end;

function TFlicPlayer.GetSpeed: TPlaySpeed;
begin
   FSpeed := GetValueOf(AA_SPEED);
   Result := FSpeed;
end;

procedure TFlicPlayer.SetSpeed(NewValue: TPlaySpeed);
begin
   if FSpeed <> NewValue then
   begin
      FSpeed := NewValue;
      aaSetParm(FFlicWnd, AA_SPEED, 0, Ord(NewValue));
   end;
end;

function TFlicPlayer.GetDesignedSpeed: TDesignedSpeed;
begin
   FDesignedSpeed := GetValueOf(AA_DESIGNSPEED);
   Result := FDesignedSpeed;
end;

procedure TFlicPlayer.SetDesignedSpeed(NewValue: TDesignedSpeed);
begin
end;

function TFlicPlayer.GetFrames: TFlicFrames;
begin
   FFrames := GetValueOf(AA_FRAMES);
   Result := FFrames;
end;

procedure TFlicPlayer.SetFrames(NewValue: TFlicFrames);
begin
end;

function TFlicPlayer.GetLoops: TPlayLoops;
begin
   FLoops := GetValueOf(AA_LOOPS);
   Result := FLoops;
end;

procedure TFlicPlayer.SetLoops(NewValue: TPlayLoops);
begin
   if FLoops <> NewValue then
   begin
      FLoops := NewValue;
      aaSetParm(FFlicWnd, AA_LOOPS, 0, FLoops);
   end;
end;

function TFlicPlayer.GetPlaying: Boolean;
begin
   Result := FPlaying;
end;

procedure TFlicPlayer.SetPlaying(NewValue: Boolean);
begin
   if FPlaying <> NewValue then
   begin
      FPlaying := NewValue;
      if FPlaying then
         Play
      else
         AutoPlay := False;
   end;
end;

function TFlicPlayer.GetStopped: Boolean;
begin
   Result := FStopped;
end;

procedure TFlicPlayer.SetStopped(NewValue: Boolean);
begin
   if FStopped <> NewValue then
   begin
      FStopped := NewValue;
      if FStopped then
         Stop
      else
         Play;
   end;
end;

function TFlicPlayer.GetPaused: Boolean;
begin
   Result := FPaused;
end;

procedure TFlicPlayer.SetPaused(NewValue: Boolean);
begin
   if FPaused <> NewValue then
   begin
      FPaused := NewValue;
      if FPaused then
         Pause
      else
         Play;
   end;
end;

procedure TFlicPlayer.Play;
begin
   FPosition := GetValueOf(AA_POSITION);
   if not FStopped and not FPaused then
      Exit;
   if StartPlay(FFlicWnd, Handle) then
   begin
      ChangeMode(cmPlay);
      if RunTime then
         TriggerPlayEvent;
   end
   else
      ChangeMode(cmStop);
end;

procedure TFlicPlayer.Pause;
begin
   FPosition := GetValueOf(AA_POSITION);
   if not FPlaying then
      Exit;
   if aaPause(FFlicWnd) then
   begin
      ChangeMode(cmPause);
      if RunTime then
         TriggerPauseEvent;
   end
   else
      ChangeMode(cmPlay);
end;

procedure TFlicPlayer.Stop;
begin
   FPosition := GetValueOf(AA_POSITION);
   if not FPlaying and not FStopped then
      Exit;
   if aaStop(FFlicWnd) then
   begin
      ChangeMode(cmStop);
      if RunTime then
         TriggerStopEvent;
   end
   else
      ChangeMode(cmPlay);
end;

procedure TFlicPlayer.TriggerPlayEvent;
begin
   if Assigned(FOnPlay) then
      FOnPlay(Self);
end;

procedure TFlicPlayer.TriggerPauseEvent;
begin
   if Assigned(FOnPause) then
      FOnPause(Self);
end;

procedure TFlicPlayer.TriggerStopEvent;
begin
   if Assigned(FOnStop) then
      FOnStop(Self);
end;

procedure TFlicPlayer.ChangeMode(Mode: TChangeMode);
begin
   FPlaying := (Mode = cmPlay);
   FStopped := (Mode = cmStop);
   FPaused := (Mode = cmPause);
end;

procedure TFlicPlayer.WMMove(var Msg: TWMMove);
var
   LocalBoundsRect: TRect;
begin
   inherited;
   LocalBoundsRect := BoundsRect;
   BoundsRect := LocalBoundsRect;
end;

procedure TFlicPlayer.WMSize(var Msg: TWMSize);
begin
   inherited;
   ResizeComponent;
end;

procedure TFlicPlayer.ResizeComponent;
begin
   if FAutoSize then
   begin
      Width := GetValueOf(AA_WIDTH);
      Height := GetValueOf(AA_HEIGHT);
   end;
end;

function TFlicPlayer.RunTime: Boolean;
begin
   RunTime := not (csDesigning in ComponentState);
end;

constructor TFlicPlayer.Create(Owner: TComponent);
begin
   inherited Create(Owner);
   FSpeed := 0;
   FFrames := 0;
   FLoops := 1;
   FPlaying := False;
   FStopped := True;
   FPaused := False;
   ResizeComponent;
   FPosition := 0;
   FFlicWnd := 0;
   FAutoSize := True;
   FTransitionIn := trFadeBlack;
   FTransitionOut := trFadeBlack;
   FAutoPlay := False;
   FFileType := ptFlic;
end;

procedure TFlicPlayer.WMCreate(var Msg: TWMCreate);
begin
   aaOpen;
   inherited;
end;

procedure TFlicPlayer.WMDestroy(var Msg: TWMDestroy);
begin
   if FFlicWnd <> 0 then
      aaUnload(FFlicWnd);
   inherited;
end;

procedure TFlicPlayer.LoadFromFile(FileStr: TFileName);
var
   PFile: PChar;
   PLen: Integer;
   LoadW, LoadH: Integer;
begin
   PLen := Length(FileStr);
   try
      if FFlicWnd <> 0 then
         aaUnload(FFlicWnd);
      GetMem(PFile,PLen);
      StrPCopy(PFile,FileStr);
      LoadW := 0;
      LoadH := 0;
      if not FAutoSize then
      begin
         LoadW := Width;
         LoadH := Height;
      end;
      FFlicWnd := aaLoad(PFile, Handle, 0, 0, 0, LoadW, LoadH, 0, 0);
      if FAutoSize then
      begin
         Width := GetValueOf(AA_WIDTH);
         Height := GetValueOf(AA_HEIGHT);
      end;
      FPosition := GetValueOf(AA_POSITION);
   finally
      FreeMem(PFile, PLen);
   end;
   if FAutoPlay then
      Play;
end;

function TFlicPlayer.GetValueOf(Value: LongInt): LongInt;
begin
   Result := aaGetParm(FFlicWnd, Value);
end;

function StartPlay(AnimWin, FocusWin: HWnd): Boolean;
var
   SaveFocus: HWnd;
begin
   SaveFocus := GetActiveWindow;
   LockWindowUpdate(FocusWin);
   Result := aaPlay(AnimWin);
   SetActiveWindow(SaveFocus);
   LockWindowUpdate(0);
end;

procedure Register;
begin
   RegisterComponents('Custom', [TFlicPlayer]);
end;

initialization
end.